home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happysrc / pcexpres.c < prev    next >
Text File  |  1993-11-30  |  36KB  |  872 lines
  1. /************************************************************/
  2. /*                                                          */
  3. /*       *** HAPPy Pascal Compiler ***                      */
  4. /*        式のコンパイル処理                                */
  5. /*      void expression(Set fsys) ;                         */
  6. /*                                                          */
  7. /*                 Copyright (c) H.Asano 1992               */
  8. /*                                                          */
  9. /************************************************************/
  10.  
  11. #define EXTERN extern
  12. #include "pascomp.h"
  13. #include "pcpcd.h"
  14.  
  15. extern void gen0(enum pcdmnc) ;
  16. extern void gen1(enum pcdmnc,int) ;
  17. extern void gen0t(enum pcdmnc,stp*) ;
  18. extern void gen1t(enum pcdmnc,stp*,int)     ;
  19. extern void gen2t(enum pcdmnc,stp*,int,int) ;
  20. extern void gencompare(enum pcdmnc,char,int) ;
  21. extern void genldc(char,long) ;
  22. extern void genixa(long,int)  ;
  23. extern void genchk(stp*,int,long,long) ;
  24. extern void convertint(stp*)  ;
  25. extern void load(void) ;
  26. extern void loadaddress(void) ;
  27. extern ctp  *searchsection(ctp*) ;
  28. extern ctp  *searchid(Set) ;
  29. extern void insymbol(void) ;
  30. extern void pcerr(int,char*);
  31. extern char *inttoch(long)  ;
  32. extern void skip(Set) ;
  33. extern boolean string(stp*) ;
  34. extern boolean compatible(stp*,stp*) ;
  35. extern void getbounds(stp*,long*,long*) ;
  36. extern int align(stp*,int) ;
  37. extern Set  *mkset(Set*,int,...) ;
  38. extern Set  *orset(Set*,Set*) ;
  39. extern void call(Set,ctp*) ;
  40. extern void *Malloc(int)   ;
  41. static void array(Set) ;
  42. static void recordmember(void) ;
  43. static void ptr(void) ;
  44. static void factident(Set) ;
  45. static void factconst(Set) ;
  46. static void factlparent(Set) ;
  47. static void factnot(Set)   ;
  48. static void factset(Set)   ;
  49. static void factset2(Set,stp*,boolean*) ;
  50. static void factnil(void)  ;
  51. static void simpleexpression(Set) ;
  52. static void plusminusope(attr,enum operator) ;
  53. static void orope(attr)    ;
  54. static void mulope(attr)   ;
  55. static void rdivope(attr)  ;
  56. static void inope(attr)    ;
  57. static void relope(attr,enum operator)  ;
  58. static void cnvfloat(attr*)   ;
  59.  
  60. /*******************************************/
  61. /* expression() : 式のコンパイル処理メイン */
  62. /*******************************************/
  63. void expression(Set fsys)
  64. {
  65.   stp  in_set ;                         /* in演算子の処理のために必要 */
  66.   attr lattr ;
  67.   enum operator lop ;
  68.   Set ws ;
  69.  
  70.      ws = fsys ;
  71.      addset(ws,relop) ;
  72.      simpleexpression(ws) ;
  73.  
  74.      if(sy == relop) {                  /* 関係演算子の時             */
  75.       if(gattr.typtr)
  76.        if(gattr.typtr->form <= power)   /*  スカラ､範囲型､集合型の時  */
  77.         load() ;                        /*   load命令                 */
  78.        else loadaddress() ;             /*  それ以外は間接参照        */
  79.       lattr = gattr ;                   /* 今の式の属性を退避         */
  80.       lop   = op    ;                   /* 今の演算子を退避           */
  81.  
  82.       if(lop == inop)                   /* in の時 integerでなければ  */
  83.        if(gattr.typtr && (gattr.typtr->form == scalar) &&
  84.           (gattr.typtr != realptr))    /* inの前の式が順序型の時     */
  85.         convertint(gattr.typtr) ;       /* 必要ならord命令生成        */
  86.  
  87.       insymbol()    ;
  88.       simpleexpression(fsys) ;          /* 関係演算子の次の単純式の処理*/
  89.       if(gattr.typtr)
  90.        if(gattr.typtr->form <= power)   /* スカラ､範囲型､集合型の時   */
  91.         load() ;                        /*  load命令                  */
  92.        else loadaddress() ;             /* それ以外は間接参照         */
  93.  
  94.       if((lattr.typtr) && (gattr.typtr))
  95.        if(lop == inop) inope(lattr) ;   /* in 演算子処理              */
  96.        else {
  97.         if(lattr.typtr != gattr.typtr)
  98.          cnvfloat(&lattr) ;             /* realへの変換処理           */
  99.  
  100.         if(compatible(lattr.typtr,gattr.typtr))  /* 両方の型が同じ    */
  101.          relope(lattr,lop) ;            /* 関係演算子の処理           */
  102.         else pcerr(143,"") ;            /* 演算子の両端の型が不一致   */
  103.        }
  104.  
  105.       gattr.typtr = boolptr ;
  106.       gattr.kind  = expr    ;           /* これ以降論理型の式とする   */
  107.      } 
  108.  
  109. }
  110.  
  111. /**************************************/
  112. /*      inope() : in 演算子処理       */
  113. /**************************************/
  114. static void inope(attr fattr)
  115. {
  116.      if(gattr.typtr->form == power)           /* 今の型が集合型          */
  117.       if(compatible(fattr.typtr,gattr.typtr->sf.pw.elset))
  118.                                               /* 底基の型と等しいか      */
  119.        gen0(iINN) ;                           /* inn命令を生成           */
  120.       else {
  121.        pcerr(143,"") ;                        /* 演算子の両端の型が不一致*/
  122.        gattr.typtr = nil ;
  123.       }
  124.      else {
  125.       pcerr(130,"") ;                         /* 式は集合型でない        */
  126.       gattr.typtr = nil  ;
  127.      }
  128. }
  129.  
  130. /*****************************************/
  131. /*  relope() : in 以外の関係演算子処理   */
  132. /*              =  <  >  <>  <=  >=      */
  133. /*****************************************/
  134. static void relope(attr fattr,enum operator fop)
  135. {
  136.   int lsize ;                           /* 比較する大きさ             */
  137.   char typind ;                         /* 比較命令の型               */
  138.  
  139.      lsize = fattr.typtr->size ;        /* その型の大きさ             */
  140.  
  141.      switch(fattr.typtr->form) {        /* 型で振り分ける             */
  142.       case scalar :                     /* スカラー                   */
  143.         if(fattr.typtr == realptr)      typind = 'r' ;  /* real       */
  144.         else if(fattr.typtr == boolptr) typind = 'b' ;  /* boolean    */
  145.         else if(fattr.typtr == charptr) typind = 'c' ;  /* char       */
  146.         else                            typind = 'i' ;  /* integer/列挙型*/
  147.         break ;
  148.       case pointer :                    /* ポインタ型                 */
  149.         if((fop != eqop) && (fop != neop)) /* =  <> 以外              */
  150.          pcerr(131,"") ;                /* 等しいかどうかの判定しか駄目*/
  151.         typind = 'a'   ;
  152.         break ;
  153.       case power   :                    /* 集合型                     */
  154.         if((fop == ltop) || (fop == gtop)) /* <  >  の時              */
  155.          pcerr(132,"") ;                /*  完全包含の判定は駄目      */
  156.         typind = 's'   ;
  157.         break ;
  158.       case arrays :                     /* 配列型                     */
  159.         if(! string(fattr.typtr))       /*  文字列でない時            */
  160.          pcerr(134,"") ;                /*  演算対象の型に誤り        */
  161.          typind = 'm'  ;
  162.          break ;
  163.       case records :                    /* レコード型                 */
  164.         pcerr(134,"")  ;                /*  レコード型は駄目          */
  165.         typind = 'm'   ;
  166.         break          ;
  167.       case files :                      /* ファイル型                 */
  168.         pcerr(133,"")  ;                /*   ファイルの比較は駄目     */
  169.         typind = 'f'   ;
  170.      }
  171.  
  172.      switch(fop) {                      /* 演算子で生成命令を区別     */
  173.       case ltop : gencompare(iLES,typind,lsize) ; /*   <  les命令     */
  174.                   break ;
  175.       case leop : gencompare(iLEQ,typind,lsize) ; /*   <= leq命令     */
  176.                   break ;
  177.       case gtop : gencompare(iGRT,typind,lsize) ; /*   >  grt命令     */
  178.                   break ;
  179.       case geop : gencompare(iGEQ,typind,lsize) ; /*   >= geq命令     */
  180.                   break ;
  181.       case neop : gencompare(iNEQ,typind,lsize) ; /*   <> neq命令     */
  182.                   break ;
  183.       case eqop : gencompare(iEQU,typind,lsize) ; /*   =  equ命令     */
  184.      }
  185. }
  186.  
  187. /**************************************/
  188. /* cnvfloat() : realへの変換処理      */
  189. /**************************************/
  190. static void cnvfloat(attr *fattr)
  191. {
  192.  
  193.       if((*fattr).typtr == intptr) {    /* 前の式だけがinteger        */
  194.        gen0(iFLO) ;                     /*  前の式を realに変換       */
  195.        (*fattr).typtr = realptr ;
  196.       }
  197.       else if(gattr.typtr == intptr) {  /* 今の式だけがinteger        */
  198.        gen0(iFLT) ;                     /*  今の式をrealに変換        */
  199.        gattr.typtr = realptr ;
  200.       }
  201. }
  202.  
  203. /***************************************/
  204. /* selector() : 変数の属性を選択する   */
  205. /*      α[･･･]  :  配列変数           */
  206. /*      α^      :  ポインタ変数       */
  207. /*      α.      : レコード変数        */
  208. /***************************************/
  209. void selector(Set fsys, ctp *fcp)
  210. {
  211.   Set ws ;
  212.  
  213.      gattr.typtr = fcp->idtype ;        /* 型を設定                   */
  214.      gattr.kind  = varbl       ;        /* 種類は 変数                */
  215.      switch(fcp->klass) {               /* 変数の型で振り分ける       */
  216.       case vars :                       /*[変数]                      */
  217.         if(fcp->n.v.vkind == actual) {  /*  実変数                    */
  218.          gattr.access = drct ;
  219.          gattr.vlevel = fcp->n.v.vlev ;
  220.          gattr.dplmt  = fcp->n.v.vaddr;
  221.         }
  222.         else {                          /*  formal (変数引数)         */
  223.          gen2t(iLOD,nilptr,level-fcp->n.v.vlev,fcp->n.v.vaddr) ;
  224.          gattr.access = indrct ;
  225.          gattr.idplmt = 0      ;
  226.          gattr.vlevel = fcp->n.v.vlev ; /* ファイルが変数引数の時の   */
  227.          gattr.dplmt  = fcp->n.v.vaddr; /* ために退避しておく         */
  228.         }                               /* 本当はこのやり方は違反です */
  229.         break ;
  230.  
  231.       case field :                      /* レコードのフィールド       */
  232.                                         /* with文配下しかこないはず   */
  233.         if(display[disx].occur == crec){/* 固定フィールドの時         */
  234.          gattr.access = drct ;
  235.          gattr.vlevel = display[disx].clev ;
  236.          gattr.dplmt  = display[disx].cdspl+ fcp->n.fldaddr ;
  237.         }
  238.         else {                          /* vrec(可変フィールドの時)   */
  239.          if(level == 1)                 /* 大域変数                   */
  240.           gen1t(iLDO,nilptr,display[top].vdspl) ;        /* ldo命令   */
  241.          else  gen2t(iLOD,nilptr,0,display[top].vdspl) ; /* lod命令   */
  242.          gattr.access = indrct ;
  243.          gattr.idplmt = fcp->n.fldaddr ;
  244.         }
  245.        break;
  246.  
  247.       case func  :                      /* 関数                       */
  248.         gattr.access = drct ;
  249.         gattr.vlevel = fcp->n.pf.sd.d.pflev + 1 ;
  250.         gattr.dplmt  = 0    ;
  251.          
  252.      }
  253.  
  254.      ws = selectsys ;
  255.      orset(&ws,&fsys) ;
  256.      if(! inset(ws,sy)) {
  257.       pcerr(59,"") ;                    /* 変数に誤りがある           */
  258.       skip(ws)     ;                    /* fsys+selectsysまで読み飛ばし*/
  259.      }
  260.  
  261.      while(inset(selectsys,sy)) {       /* [  .  ^  の間処理する      */
  262.       if(sy == lbrack)                  /*  [ の時                    */
  263.        array(fsys) ;                    /*   配列の処理               */
  264.       else if(sy == period)             /*  . の時                    */
  265.        recordmember() ;                 /*   レコードの各要素の処理   */
  266.       else                              /*  ^ の時                    */
  267.        ptr() ;                          /*    ポインタの処理          */
  268.  
  269.       if(! inset(ws,sy)) {
  270.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  271.        skip(ws) ;
  272.       }
  273.      }
  274. }
  275.  
  276. /*****************************************/
  277. /* recordmember() : レコードの要素の処理 */
  278. /*****************************************/
  279. static void recordmember(void)
  280. {
  281.   ctp *lcp ;
  282.  
  283.      if(gattr.typtr)
  284.       if(gattr.typtr->form != records) {
  285.        pcerr(140,"") ;                  /* 変数の型がレコード型でない */
  286.        gattr.typtr = nil ;              /* 今後のエラー防止のためnilにする*/
  287.       }
  288.  
  289.      insymbol() ;                       /* 次のsymbol                 */
  290.      if(sy == ident) {                  /*  名前                      */
  291.       if(gattr.typtr) {                 /*  レコードの要素から名前を探す*/
  292.        lcp = searchsection(gattr.typtr->sf.re.fstfld) ;
  293.        if(!lcp) {                       /*  名前がない時              */
  294.         pcerr(152,id) ;                 /*  レコードの欄ではない      */
  295.         gattr.typtr = nil ;             /* 今後のエラー防止のためnilにする*/
  296.        }
  297.        else {                           /* 名前がレコードの欄の時     */
  298.         gattr.typtr = lcp->idtype ;     /*   名前の型                 */
  299.         if(gattr.access==drct)          /* 直接参照の時               */
  300.            gattr.dplmt += lcp->n.fldaddr ; 
  301.         else                            /* 間接参照の時(indrct)       */
  302.            gattr.idplmt += lcp->n.fldaddr ;
  303.        }           
  304.       }                                 /* end (typtr != nil)         */ 
  305.       insymbol() ;                      /* 名前の次を読み込む         */
  306.      }
  307.      else pcerr(2,"") ;                 /* 名前がない                 */  
  308. }
  309.  
  310. /*****************************************/
  311. /*      array() : 配列の処理             */
  312. /*****************************************/
  313. static void array(Set fsys)
  314. {
  315.   attr lattr ;                          /* 1つ前の属性                */
  316.   long lmin,lmax ;
  317.   int lsize ;
  318.   Set  ws    ;
  319.  
  320.      do {                               /* 多次元配列のための繰り返し */
  321.       lattr = gattr ;
  322.       if(lattr.typtr)
  323.        if(lattr.typtr->form != arrays) {
  324.         pcerr(138,"") ;                 /* 変数の型は配列でない       */
  325.         lattr.typtr = nil ;
  326.         gattr.typtr = nil ;             /* loadaddressをさせない      */
  327.        }
  328.       loadaddress() ;
  329.       insymbol() ;
  330.       mkset(&ws, comma,rbrack, -1) ;
  331.       orset(&ws, &fsys) ;
  332.       expression(ws)    ;               /* 添え字の式の処理           */
  333.       load() ;
  334.       if(gattr.typtr)
  335.        if(gattr.typtr->form != scalar)
  336.         pcerr(113,"") ;                 /* 添え字の型はスカラか範囲型 */
  337.        else
  338.         convertint(gattr.typtr) ;       /* 必要ならord命令生成        */
  339.  
  340.       if(lattr.typtr) {
  341.        if(compatible(lattr.typtr->sf.ar.inxtype,
  342.                      gattr.typtr)) {    /* 添え字の型と等しい         */
  343.         if(lattr.typtr->sf.ar.inxtype) {
  344.          getbounds(lattr.typtr->sf.ar.inxtype,&lmin,&lmax);
  345.          if(debug) genchk(intptr,1,lmin,lmax) ;   /* chk命令生成      */
  346.         }
  347.        }
  348.        else pcerr(139,"") ;             /* 添え字の型が宣言と一致しない*/
  349.  
  350.        gattr.typtr  = lattr.typtr->sf.ar.aeltype ; /* 要素の型         */
  351.        gattr.kind   = varbl ;
  352.        gattr.access = indrct ;
  353.        gattr.idplmt = 0 ;
  354.       
  355.        if(gattr.typtr) {
  356.         lsize = gattr.typtr->size ;
  357.         lsize = align(gattr.typtr,lsize) ; /* 境界合わせ              */
  358.         genixa(lmin,lsize) ;               /* lxa命令の生成           */
  359.        }
  360.       }  
  361.  
  362.      } while(sy == comma) ;
  363.  
  364.      if(sy == rbrack) insymbol() ;
  365.      else pcerr(12,"") ;                /* ] がない                   */
  366. }
  367.  
  368. /*****************************************/
  369. /*      ptr() : ポインタ参照の処理       */
  370. /*****************************************/
  371. static void ptr(void)
  372. {
  373.      if(gattr.typtr) 
  374.       if(gattr.typtr->form == pointer) { /* ポインタ型の時            */
  375.        load() ;
  376.        gattr.typtr = gattr.typtr->sf.pt.eltype ; /* 指し示すものの型  */
  377.        if(debug)                        /* デバッグコンパイルの時     */
  378.         gen0(iCKA) ;                    /* CKA命令                    */
  379.        gattr.kind   = varbl ;
  380.        gattr.access = indrct ;          /* 間接参照                   */
  381.        gattr.idplmt = 0      ;
  382.       }
  383.       else if(gattr.typtr->form == files) /* ファイル型の時           */
  384.        gattr.typtr = gattr.typtr->sf.fi.filtype ; /* ファイルの基の型 */
  385.       else pcerr(141,"") ;              /* ファイル型か指標型でない   */
  386.       
  387.       insymbol() ;
  388. }
  389.  
  390. /**************************************/
  391. /* factor() : 式の因子(factor)の処理  */
  392. /**************************************/
  393. static void factor(Set fsys)
  394. {
  395.   Set ws ;
  396.  
  397.      if(! inset(facbegsys,sy)) {
  398.       pcerr(58,"") ;                    /* 項に誤りがある             */
  399.       ws = fsys ;
  400.       orset(&ws, &facbegsys) ;
  401.       skip(ws) ;                        /* fsys+factbegsysまで読み飛ばし*/
  402.       gattr.typtr = nil ;
  403.      }
  404.  
  405.      while(inset(facbegsys,sy)) {
  406.       switch(sy) {
  407.        case ident       :               /* 名前の時                   */
  408.               factident(fsys) ;
  409.               break ;
  410.        case intconst    :               /* 整数定数                   */
  411.        case realconst   :               /* 実数定数                   */
  412.        case stringconst :               /* 文字列                     */
  413.               factconst(fsys) ;
  414.               break ;
  415.        case lparent     :               /* (                          */
  416.               factlparent(fsys) ;
  417.               break ;
  418.        case notsy       :               /* not                        */
  419.               factnot(fsys) ;
  420.               break ;
  421.        case lbrack      :               /* [    集合の始まり記号      */
  422.               factset(fsys) ;
  423.               break ;
  424.        case nilsy       :               /* nil                        */
  425.               factnil() ;
  426.               break ;
  427.       }
  428.       if(! inset(fsys,sy)) {
  429.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  430.        skip(ws)    ;                    /* fsys+factbegsysまで読み飛ばし*/
  431.       }
  432.      }
  433. }
  434.  
  435. /**************************************/
  436. /*     factident() : 名前因子の処理   */
  437. /**************************************/
  438. static void factident(Set fsys)
  439. {
  440.   ctp *lcp ;
  441.   Set ws ;
  442.  
  443.      mkset(&ws, konst,vars,field,func,-1) ; /* 名前を､定数･変数･フィールド･ */
  444.      lcp = searchid(ws) ;                   /* 関数の中から探す             */
  445.      insymbol() ;
  446.  
  447.      if(lcp->klass == func) {
  448.       call(fsys,lcp) ;                  /* 関数の時､関数呼び出し      */
  449.       gattr.kind = expr ;
  450.       if(gattr.typtr)
  451.        if(gattr.typtr->form == subrange) /* 範囲型の時                */
  452.         gattr.typtr = gattr.typtr->sf.su.rangetype ; /* 基の型        */
  453.     }
  454.     else if(lcp->klass == konst) {      /* 定数の時                   */
  455.      gattr.typtr = lcp->idtype ;
  456.      gattr.kind  = cst ;
  457.      gattr.cval  = lcp->n.values ;      /*  値を入れる                */
  458.     }
  459.     else {                              /* 変数､レコードフィールドの時*/
  460.      selector(fsys,lcp) ;               /* 属性選択                   */
  461.      if(gattr.typtr)
  462.       if(gattr.typtr->form == subrange) /* 範囲型の時                 */
  463.        gattr.typtr = gattr.typtr->sf.su.rangetype ; /* 基の型         */
  464.     }
  465. }
  466.  
  467. /**************************************/
  468. /*     factconst() : 定数因子の処理   */
  469. /**************************************/
  470. static void factconst(Set fsys)
  471. {
  472.   stp *lsp,*lsp1 ;
  473.  
  474.      gattr.kind = cst ;
  475.      switch(sy) {
  476.       case intconst :                   /* 整数定数                   */
  477.         gattr.typtr = intptr ;
  478.         gattr.cval  = val    ;          /* 値を設定                   */
  479.         break ;
  480.  
  481.       case realconst :                  /* 実数定数                   */
  482.         gattr.typtr = realptr ;
  483.         gattr.cval   = val    ;
  484.         break ;
  485.  
  486.       case stringconst :                /* 文字列                     */
  487.         if(lgth == 1)                   /*  1文字                     */
  488.          gattr.typtr  = charptr ;       /*  char型とする              */
  489.         else if(lgth == 0)              /*  0文字(エラー)             */
  490.          gattr.typtr  = nil     ;       /*  型なし                    */
  491.         else {                          /*  2文字以上ある時           */
  492.          lsp = (stp*)Malloc(sizeof(stp)); /* 配列型とする             */
  493.          lsp->form = arrays ;
  494.          lsp->size = lgth*charsize ;
  495.          lsp->sf.ar.packed  = true    ;    /* 詰め込み型              */
  496.          lsp->sf.ar.aeltype = charptr ;    /* 要素の型は文字型        */
  497.          lsp1 = (stp*)Malloc(sizeof(stp)) ;/*  添字の型は             */
  498.          lsp1->form = subrange          ;  /*        範囲型           */
  499.          lsp1->size = intsize           ;
  500.          lsp1->sf.su.rangetype = intptr ;
  501.          lsp1->sf.su.min = 1            ;  /*  添字の下限値は1        */
  502.          lsp1->sf.su.max = (long)lgth   ;  /*  添字の上限値は文字列長 */
  503.          lsp->sf.ar.inxtype = lsp1      ;  /*  添字の型をこの範囲型とする*/
  504.          gattr.typtr = lsp ;
  505.         }
  506.         gattr.cval = val ;
  507.      }   
  508.      insymbol() ;
  509. }
  510.  
  511. /**************************************/
  512. /*   factlparent() : (～)の処理       */
  513. /**************************************/
  514. static void factlparent(Set fsys)
  515. {
  516.   Set ws ;
  517.  
  518.      insymbol() ;
  519.      ws = fsys  ;
  520.      addset(ws,rparent) ;
  521.      expression(ws) ;                   /* )が出てくるまで式の処理    */
  522.      if(sy == rparent) insymbol() ;
  523.      else pcerr(4,"")             ;     /* ) がない                   */
  524. }
  525.  
  526. /**************************************/
  527. /*     factnot() : not の処理         */
  528. /**************************************/
  529. static void factnot(Set fsys)
  530. {
  531.      insymbol()   ;
  532.      factor(fsys) ;                     /* notの次の因子の解析        */
  533.      load()       ;                     /* load命令の出力             */
  534.      if(gattr.typtr != boolptr) {
  535.       pcerr(135,"not") ;                /*  論理型でないといけない    */
  536.       gattr.typtr = nil  ;              /*  次のエラーをださないためnil*/
  537.      }
  538.      gen0(iNOT)   ;                     /* not命令の出力              */
  539. }
  540.  
  541. /**************************************/
  542. /*     factset() : 集合の処理         */
  543. /**************************************/
  544. static void factset(Set fsys)
  545. {
  546.   stp *lsp ;
  547.   csp *lvp ;
  548.   Set csetpart ;
  549.   boolean varpart ;                     /* 変数要素がある時 true      */
  550.   boolean cstpart ;                     /* 定数要素がある時 true      */
  551.   boolean test   ;
  552.   Set ws  ;
  553.  
  554.      insymbol() ;
  555.      mkset(&csetpart,-1) ;              /* 固定要素集合のクリア       */
  556.      varpart = false     ;
  557.      cstpart = false     ;
  558.      lsp = (stp*)Malloc(sizeof(stp)) ;  /* 集合の型を作成             */
  559.      lsp->form          = power  ;
  560.      lsp->size         = setsize ;
  561.      lsp->assignflag   = true    ;
  562.      lsp->sf.pw.packed = both    ;
  563.      lsp->sf.pw.elset  = nil     ;
  564.      lsp->sf.pw.elmin  = setlow  ;
  565.      lsp->sf.pw.elmax  = sethigh ;
  566.  
  567.      if(sy == rbrack) {                 /* 空集合の時                 */
  568.       gattr.typtr = lsp ;
  569.       gattr.kind  = cst ;
  570.       insymbol() ;
  571.      }
  572.  
  573.      else {                             /* 要素がある時               */
  574.       do {
  575.        mkset(&ws,comma,rbrack,period2,-1);
  576.        orset(&ws,&fsys) ;
  577.        expression(ws)   ;               /* 要素                       */
  578.        if(gattr.typtr)
  579.         if((gattr.typtr->form != scalar)/* 要素が順序型かチェック     */
  580.         || (gattr.typtr == realptr)) {
  581.          pcerr(136,"") ;                /*  要素記述は順序型のこと　  */
  582.          gattr.typtr = nil ;
  583.         }
  584.         else {
  585.          if(!lsp->sf.pw.elset)          /* 集合の型がない時           */
  586.           lsp->sf.pw.elset = gattr.typtr ;/* 要素の型を集合の型とする */
  587.          if(compatible(lsp->sf.pw.elset,gattr.typtr)){   /* 要素の型  */
  588.           if(sy == period2) factset2(fsys,lsp,&varpart) ; /* .. の処理*/
  589.           else {                        /* 通常の集合要素の処理       */
  590.            if(gattr.kind == cst)        /* 要素が定数                 */
  591.             if((gattr.cval.ival < (long)lsp->sf.pw.elmin) || /* 集合の*/
  592.                (gattr.cval.ival > (long)lsp->sf.pw.elmax))   /* 範囲  */
  593.              pcerr(607,inttoch((long)lsp->sf.pw.elmax)) ;/* 範囲内にない*/
  594.             else {
  595.              addset(csetpart,gattr.cval.ival) ;/* 定数の集合に加える  */
  596.              cstpart = true ;
  597.             } 
  598.            else {                       /* 要素が変数の時             */
  599.             load() ;                    /* 要素値をload               */
  600.             convertint(gattr.typtr) ;   /* 必要ならord命令生成        */
  601.             if(debug)
  602.              genchk(intptr,111,         /* 式がHAPPyの集合範囲に入るか*/
  603.              (long)lsp->sf.pw.elmin,(long)lsp->sf.pw.elmax) ;
  604.                                         /*  集合要素の範囲チェック    */
  605.             gen0(iSGS) ;                /* sgs命令(要素1個の集合作成) */
  606.             if(varpart) gen0(iUNI)  ;   /* uni命令(変数の集合に加える)*/
  607.             else varpart = true     ;   /* 初めて変数が現れた時 trueに*/
  608.            }
  609.           }
  610.          }
  611.          else pcerr(137,"") ;           /* 集合の要素の型が不一致     */
  612.         }
  613.        
  614.        if(test=(sy==comma)) insymbol(); /* , なら次の要素を読む       */
  615.       } while(test) ;                   /* , ならば次の要素の処理     */
  616.  
  617.       if(sy == rbrack) insymbol() ;     /* ] ならば次のsymbolを読む   */
  618.       else pcerr(12,"") ;               /* ] がない                   */
  619.  
  620.       gattr.typtr = lsp ;               /* 集合の型を入れる           */
  621.  
  622.      }
  623.  
  624.      lvp = (csp*)Malloc(sizeof(csp)) ;  /* 集合定数のエリア確保       */
  625.      lvp->cclass = pset ;
  626.      lvp->c.pval = csetpart ;
  627.      gattr.cval.valp = lvp  ;
  628.  
  629.      if(varpart) {                      /* 変数の要素があった時       */
  630.       if(cstpart) {                     /* 定数要素があった時         */
  631.        genldc('s',(long)nil) ;          /* ldcs命令                   */
  632.        gen0(iUNI) ;                     /* uni命令                    */
  633.        gattr.kind = expr ;
  634.       }
  635.      }
  636. }
  637.  
  638. /****************************************/
  639. /*  factset2() :  集合の 範囲要素の処理 */
  640. /*                 順序式..順序式       */
  641. /****************************************/
  642. static void factset2(Set fsys,stp *fsp,boolean *varpart)
  643. {
  644.   attr lattr ;
  645.   Set ws    ;
  646.  
  647.      if(gattr.kind == cst)              /* 要素が定数                 */
  648.       if((gattr.cval.ival < (long)fsp->sf.pw.elmin) ||/* 要素の範囲   */
  649.          (gattr.cval.ival > (long)fsp->sf.pw.elmax))  /*   チェック   */
  650.        pcerr(607,inttoch((long)fsp->sf.pw.elmax)) ;/* 範囲内にない    */
  651.      lattr = gattr ;
  652.      load() ;                           /*  要素をload                */
  653.      convertint(gattr.typtr) ;          /* 必要ならord命令生成        */
  654.       if(debug)
  655.        genchk(intptr,111,(long)fsp->sf.pw.elmin,(long)fsp->sf.pw.elmax) ;
  656.  
  657.      insymbol() ;                       /*  次の要素を読む            */
  658.      mkset(&ws,comma,rbrack,-1);
  659.      orset(&ws,&fsys);
  660.      expression(ws)  ;                  /* 次の要素の処理             */
  661.      if(gattr.typtr) {
  662.       if(compatible(gattr.typtr,lattr.typtr)) {/* 前の要素との型チェック*/
  663.        if(gattr.kind == cst)           /* 上限値が定数                */
  664.         if((gattr.cval.ival < (long)fsp->sf.pw.elmin) || /* 要素の範囲*/
  665.            (gattr.cval.ival > (long)fsp->sf.pw.elmax))   /* チェック  */
  666.          pcerr(607,inttoch((long)fsp->sf.pw.elmax)) ;/* 範囲内にない  */
  667.        load() ;                         /* 要素をload                 */
  668.        convertint(gattr.typtr) ;        /* 必要ならord命令生成        */
  669.        if(debug)
  670.         genchk(intptr,111,(long)fsp->sf.pw.elmin,(long)fsp->sf.pw.elmax) ;
  671.        gen0(iMMS)  ;                    /* mms命令生成                */
  672.        if(*varpart) gen0(iUNI)  ;       /* uni命令(変数の集合に加える)*/
  673.        else *varpart = true     ;
  674.       } 
  675.       else pcerr(137,"") ;              /* 集合の要素の型が不一致     */
  676.      }
  677. }
  678.  
  679. /**************************************/
  680. /*     factnil() : nil の処理         */
  681. /**************************************/
  682. static void factnil(void)
  683. {
  684.      gattr.typtr      = nilptr ;        /* nil 型                     */
  685.      gattr.kind       = cst    ;
  686.      gattr.cval.ival  = 0      ;
  687.      insymbol()                ;
  688. }
  689.  
  690. /**************************************/
  691. /*    term() : 式の項(term)の処理     */
  692. /**************************************/
  693. static void term(Set fsys)
  694. {
  695.   attr lattr ;                          /* 1つ前の項の属性            */
  696.   enum operator lop ;                   /* 1つ前の演算子              */
  697.   Set ws ;
  698.  
  699.      ws = fsys ;
  700.      addset(ws,mulop) ;
  701.      factor(ws) ;                       /* 因子の処理                 */
  702.  
  703.      while(sy == mulop) {               /* * / div mod and の時       */
  704.       load() ;                          /* 今の項をload               */
  705.       lattr = gattr ;                   /* 今の項の属性を退避         */
  706.       lop   = op    ;                   /* 今の演算子を退避           */
  707.       insymbol() ;
  708.       factor(ws) ;                      /* 次の項の処理               */
  709.       load() ;                          /* その項をload               */
  710.       if((lattr.typtr) && (gattr.typtr))
  711.        switch(lop) {                    /* 演算子で振り分ける         */
  712.         case mul  : mulope(lattr) ;     /*  * 演算子処理              */
  713.                     break         ;
  714.         case rdiv : rdivope(lattr) ;    /*  / 演算子処理              */
  715.                     break          ;
  716.         case idiv  :                    /*  div 演算子                */
  717.         case imod  :                    /*  mod 演算子                */
  718.           if((lattr.typtr == intptr) &&
  719.              (gattr.typtr == intptr))   /*  div/mod の対象はinteger   */
  720.            (lop==idiv) ? gen0(iDVI) : gen0(iMOD);/*dvi / mod命令を生成*/
  721.           else {
  722.            pcerr(134,"") ;              /* 演算対象の型に誤り         */
  723.            gattr.typtr = nil ;
  724.           }
  725.           break ;
  726.         case andop :                    /*  and 演算子                */
  727.           if((lattr.typtr == boolptr) &&
  728.              (gattr.typtr == boolptr))  /*  and の対象はboolean       */
  729.            gen0(iAND) ;                 /*   and命令を生成            */
  730.           else {
  731.            pcerr(135,"and") ;           /* 論理型でない               */
  732.            gattr.typtr = nil ;  
  733.           }
  734.        }   
  735.       else gattr.typtr = nil ;
  736.      }
  737. }
  738.  
  739. /**************************************/
  740. /*      mulope() : *  演算子処理      */
  741. /**************************************/
  742. static void mulope(attr fattr)
  743. {
  744.      if((fattr.typtr == intptr) &&      /*  * の両端がinteger         */
  745.         (gattr.typtr == intptr))
  746.       gen0(iMPI) ;                      /* mpi命令の生成              */
  747.      else {
  748.       cnvfloat(&fattr) ;                /* realへの変換処理           */
  749.       if((fattr.typtr == realptr) &&
  750.          (gattr.typtr == realptr))      /* 両端ともrealになっていれば */
  751.        gen0(iMPR) ;                     /*  mpr命令を生成             */
  752.       else if((gattr.typtr->form == power)        /* 集合型で         */ 
  753.         && compatible(fattr.typtr,gattr.typtr)) { /* 型が適合する     */
  754.         if(fattr.typtr->sf.pw.packed != both) /* 前の式の詰めあり/なし*/
  755.          gattr.typtr->sf.pw.packed = fattr.typtr->sf.pw.packed   ;
  756.        gen0(iINT) ;                     /* int命令を生成              */
  757.       } 
  758.       else {                            /* 型が適合しない             */
  759.        pcerr(134,"") ;                  /* 演算対象の型に誤り         */
  760.        gattr.typtr = nil;
  761.       }
  762.      }
  763. }
  764.  
  765. /**************************************/
  766. /*      rdivope() : /  演算子処理     */
  767. /**************************************/
  768. static void rdivope(attr fattr)
  769. {
  770.      cnvfloat(&fattr) ;                 /* realへの変換処理           */
  771.      cnvfloat(&fattr) ;                 /*  を2回呼ぶ                 */
  772.      if((fattr.typtr == realptr) &&
  773.         (gattr.typtr == realptr))       /* 両端ともrealになっていれば */
  774.       gen0(iDVR) ;                      /*  dvr命令を生成             */
  775.       else {
  776.        pcerr(134,"") ;                  /* 演算対象の型に誤り         */
  777.        gattr.typtr = nil ;
  778.       }
  779. }
  780.  
  781.  
  782. /*********************************************/
  783. /*     simpleexpression() : 単純式の処理     */
  784. /*********************************************/
  785. static void simpleexpression(Set fsys)
  786. {
  787.   boolean sign = false ;
  788.   attr lattr ;
  789.   enum operator lop ;
  790.   Set ws ;
  791.  
  792.      if((op == plus) || (op == minus)){ /* + か - の時                */
  793.       sign = (op == minus)   ;          /* - の時 true                */
  794.       insymbol() ;
  795.      }
  796.  
  797.      ws = fsys ;
  798.      addset(ws,addop) ;
  799.      term(ws) ;                         /* 項の処理                   */
  800.  
  801.      if(sign) {                         /* - がついていた時           */
  802.       load() ;
  803.       if(gattr.typtr == intptr) 
  804.        gen0(iNGI)  ;                    /* ngi 命令の出力             */
  805.       else if(gattr.typtr == realptr)
  806.        gen0(iNGR)  ;                    /* ngr 命令の出力             */
  807.       else {
  808.        pcerr(134,"") ;                  /* 演算対象の型に誤り         */
  809.        gattr.typtr = nil ;              /* 今後のためにnilとする      */
  810.       }
  811.      }
  812.  
  813.      while(sy ==addop) {
  814.       load()        ;
  815.       lattr = gattr ;                   /* 今の属性を退避             */
  816.       lop   = op    ;                   /* 今の演算子を退避           */
  817.       insymbol()    ;
  818.       term(ws)      ;                   /* 項の処理                   */
  819.       load()        ;
  820.  
  821.       if((lattr.typtr) && (gattr.typtr)) 
  822.        switch(lop) {                    /* 前の演算子で振り分ける    */
  823.         case plus  :
  824.         case minus : plusminusope(lattr,lop);
  825.                      break           ;  /* + -  の演算子処理          */
  826.         case orop  : orope(lattr)    ;  /* or     演算子処理          */
  827.                      break           ;
  828.        }
  829.       else gattr.typtr = nil    ;
  830.      }
  831. }
  832.  
  833. /**************************************/
  834. /* plusminusope() : + -  演算子処理   */
  835. /**************************************/
  836. static void plusminusope(attr fattr,enum operator fop)
  837. {
  838.      if((fattr.typtr == intptr) &&      /* 前と今の式が両方ともinteger*/
  839.         (gattr.typtr == intptr))        /*   であれば                 */
  840.       (fop == plus) ? gen0(iADI) : gen0(iSBI) ; /* adi/sbi命令を生成  */
  841.      else {
  842.       cnvfloat(&fattr) ;                /* realに変換                 */
  843.       if((fattr.typtr == realptr) &&    /* 前と今の式が両方ともreal   */
  844.          (gattr.typtr == realptr))      /*   になっていれば           */
  845.        (fop == plus) ? gen0(iADR) : gen0(iSBR) ; /* adr/sbr命令を生成 */
  846.       else if((fattr.typtr->form == power)       /* 前の式が集合型で  */ 
  847.          && compatible(fattr.typtr,gattr.typtr)){/* 基底の型が同じ    */
  848.        if(fattr.typtr->sf.pw.packed != both)  /* 前の式の詰めあり/なし*/
  849.         gattr.typtr->sf.pw.packed = fattr.typtr->sf.pw.packed   ;
  850.        (fop == plus) ? gen0(iUNI) : gen0(iDIF) ; /* uni/dif命令を生成 */
  851.       } 
  852.       else {                            /* 型が適合しない             */
  853.        pcerr(134,"") ;                  /* 演算対象の型に誤り         */
  854.        gattr.typtr = nil;
  855.       }
  856.      }  
  857. }
  858.  
  859. /**************************************/
  860. /*      orope() : or 演算子処理       */
  861. /**************************************/
  862. static void orope(attr fattr)
  863. {
  864.       if((fattr.typtr == boolptr) &&    /* 前と今の式が両方ともboolean*/
  865.          (gattr.typtr == boolptr))      /*   であれば                 */
  866.        gen0(iIOR) ;                     /*   ior命令を生成            */
  867.       else {
  868.        pcerr(135,"or") ;              /*  演算対象は論理型でないと駄目*/
  869.        gattr.typtr = nil ;
  870.       }
  871. }
  872.